home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / language / parallax / more_exa.tar / more / X / xfractline.p < prev    next >
Text File  |  1993-03-04  |  3KB  |  119 lines
  1. SYSTEM fractal;
  2. CONST  maxlevel  = 10;
  3.        low_val   = 0.0;
  4.        high_val  = 1.0;
  5.        maxnode   = 2**maxlevel - 1;
  6.        leaf_end  = maxnode;
  7.        leaf_start= (leaf_end+1) DIV 2;
  8.        leaf_num  = leaf_start;
  9.        scale     = 2;
  10.        height    = scale * leaf_num DIV 3;
  11.  
  12. CONFIGURATION tree [1 .. maxnode];
  13. CONNECTION    child_l : tree[i] <-> tree[2*i].parent;
  14.               child_r : tree[i] <-> tree[2*i+1].parent;
  15.                 left    : tree[i]  -> tree[i-1].right;
  16.  
  17. SCALAR  i,j         : INTEGER;
  18.         delta       : REAL;
  19.         win         : CARDINAL;
  20.         xmax,xmin   : REAL;
  21.         ch          : CHAR;
  22.  
  23. VECTOR  x, low, high: REAL;
  24.         pos         : CARDINAL;
  25.  
  26. PROCEDURE Gauss(): VECTOR REAL;
  27. (* random number with Gaussian distribution *)
  28. CONST N = 4;
  29.       GA= (3.0*FLOAT(N))**0.5;
  30.       GF= 2.0*GA / (FLOAT(N)*FLOAT(MAX(INTEGER)));
  31. SCALAR i  : INTEGER; 
  32. VECTOR sum: REAL;
  33. BEGIN
  34.   sum:=0.0;
  35.   FOR i:=1 TO N DO sum:= sum + FLOAT(VIRandom()) END;
  36.   RETURN (GF*sum - GA)
  37. END Gauss;
  38.  
  39. PROCEDURE MidPointRec(SCALAR delta: REAL; SCALAR level: INTEGER);
  40. BEGIN
  41.   PARALLEL [2**(level-1) .. 2**level - 1]  (* select current tree level *)
  42.     x := 0.5 * (low + high) + delta*Gauss();
  43.     IF level < maxlevel THEN
  44.       SEND tree.child_l (low)  TO tree.parent(low); (* values for children *)
  45.       SEND tree.child_l (x)    TO tree.parent(high);
  46.       SEND tree.child_r (x)    TO tree.parent(low);
  47.       SEND tree.child_r (high) TO tree.parent(high);
  48.     END;
  49.   ENDPARALLEL;
  50. END MidPointRec;
  51.  
  52. PROCEDURE VSIGN(VECTOR i : integer) : VECTOR integer;
  53. VECTOR erg : integer;
  54. BEGIN
  55.    IF i = 0 THEN erg := 0 ELSE erg := i div ABS(i) END;
  56.    RETURN (erg);
  57. END VSIGN;
  58.  
  59. PROCEDURE plot(VECTOR x, y : integer; SCALAR c: COLOR);
  60. VECTOR xnext, dx, px, ynext, dy, py, m, t, i: integer;
  61. BEGIN
  62.    Setcolor(c);
  63.    PROPAGATE.left(x,xnext); dx := xnext - x;
  64.    PROPAGATE.left(y,ynext); dy := ynext - y;
  65.    IF DIM1 # REDUCE.max(DIM1) THEN
  66.       IF ABS(dx) < ABS(dy) THEN
  67.            IF dy < 0 THEN
  68.               dec(xnext,dx); inc(x,dx); dx := -dx;
  69.               dec(ynext,dy); inc(y,dy); dy := -dy;
  70.            END;
  71.            px := x; m := 0; i := VSIGN(dx); dx := ABS(dx); t := dy div 2;
  72.            FOR py := y TO ynext DO
  73.               SetPixel(px,py);
  74.               inc(m,dx);
  75.               IF m > t THEN inc(t,dy); inc(px,i); END;
  76.            END;
  77.       ELSE
  78.            IF dx < 0 THEN
  79.               dec(xnext,dx); inc(x,dx); dx := -dx;
  80.               dec(ynext,dy); inc(y,dy); dy := -dy;
  81.            END;
  82.            py := y; m := 0; i := VSIGN(dy); dy := ABS(dy); t := dx div 2;
  83.            FOR px := x TO xnext DO
  84.               SetPixel(px,py);
  85.               inc(m,dy);
  86.               IF m > t THEN inc(t,dx); inc(py,i); END;
  87.            END;
  88.       END;
  89.    END;
  90. END plot;
  91.  
  92. BEGIN (* main *)
  93.   PARALLEL
  94.     low  := low_val;   (* starting values *)
  95.     high := high_val;
  96.     x    := 0.0;
  97.   ENDPARALLEL;
  98.   FOR i:=1 TO maxlevel DO
  99.     delta := 0.5 ** (FLOAT(i)/2.0);
  100.     MidPointRec(delta,i);
  101.   END;
  102.  
  103.   win  := OpenAbswindow(leaf_num * scale, height);
  104.   IF NOT Done THEN
  105.     WriteString("scale too large"); WriteLn;
  106.   ELSE
  107.     xmin := REDUCE.min(x);
  108.     xmax := REDUCE.max(x);
  109.     PARALLEL [leaf_start..leaf_end]
  110.       pos := height - TRUNC( FLOAT(height-1) * (x-xmin)/(xmax-xmin) );
  111.       plot((DIM1-leaf_start+1)*scale, pos, COLOR(0,0,0));
  112.     ENDPARALLEL;
  113.     WriteString("Press RETURN for termination"); WriteLn;
  114.     Read(ch);
  115.     CloseWindow(win);
  116.   END
  117. END fractal.
  118.  
  119.